home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / TUT1-9.ZIP / TUTPROG7.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-12  |  24.7 KB  |  675 lines
  1. {$X+}
  2. USES crt;
  3.  
  4. CONST VGA = $a000;
  5.  
  6. Type Toastinfo = Record                 { This is format of of each of our }
  7.                  x,y:integer;              { records for the flying toasters }
  8.                  speed,frame:integer;
  9.                  active:boolean;
  10.                END;
  11.  
  12.      icon = Array [1..30*48] of byte;  { This is the size of our pictures }
  13.  
  14.      Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  15.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  16.  
  17. CONST frame1 : icon = (
  18. 0,0,0,0,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,
  19. 7,7,7,7,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,
  20. 5,7,7,7,7,7,7,7,8,8,7,7,7,7,7,7,0,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,
  21. 0,0,0,0,0,5,5,7,7,7,7,7,8,8,7,8,8,7,8,7,8,7,7,7,5,8,8,8,8,5,5,5,5,5,5,5,5,5,5,5,
  22. 5,0,0,0,0,0,0,0,0,0,0,0,5,7,7,7,7,7,7,8,7,7,7,8,7,7,7,7,7,7,0,0,0,0,0,0,8,5,5,5,
  23. 5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,5,7,7,8,8,7,7,8,7,7,8,7,7,7,7,7,0,0,0,0,0,
  24. 0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,5,7,8,8,8,7,7,8,7,7,8,7,7,7,
  25. 7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,5,7,8,8,8,7,7,
  26. 8,8,8,8,8,8,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  27. 9,5,7,8,8,8,8,8,7,7,8,8,7,7,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  28. 1,1,1,1,9,9,9,9,5,7,7,8,8,8,8,7,7,8,8,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  29. 1,1,0,0,0,1,1,1,1,1,1,1,9,9,9,5,7,8,8,7,7,8,8,7,8,8,8,7,0,0,0,0,0,0,0,0,0,0,0,0,
  30. 0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,5,7,8,8,7,7,7,7,8,8,7,7,7,0,0,0,0,
  31. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,7,8,8,8,8,8,8,8,7,
  32. 7,7,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,7,
  33. 7,7,7,7,7,7,7,7,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  34. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  35. 1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  36. 0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,
  37. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,
  38. 2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  39. 2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  40. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,4,
  41. 4,6,6,6,6,6,6,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  42. 0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
  43. 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,3,3,1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,
  44. 9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  45. 9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  46. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  47. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  48. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  49. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  50. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  51. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  52. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  53. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  54. );
  55.       frame2 : icon = (
  56. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  57. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  58. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  59. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  60. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  61. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  62. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  63. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  64. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  65. 9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  66. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
  67. 1,1,0,0,0,1,1,1,1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,
  68. 0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
  69. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,
  70. 2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,5,
  71. 5,5,5,5,5,5,5,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  72. 1,1,1,2,2,2,2,2,5,5,5,5,5,5,5,5,5,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  73. 1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,5,5,5,5,5,5,5,5,5,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  74. 0,0,0,0,0,5,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,0,0,0,0,0,
  75. 0,0,0,0,0,0,0,0,0,0,0,0,5,5,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,5,5,5,5,
  76. 5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  77. 2,2,2,2,2,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,1,1,1,1,1,0,0,0,1,1,1,
  78. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,7,1,4,
  79. 4,6,6,6,6,6,6,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,
  80. 0,0,0,5,5,1,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,5,5,5,5,5,5,5,5,0,0,
  81. 0,0,0,0,0,0,0,0,0,0,0,5,5,1,1,1,1,1,1,1,1,1,3,3,1,1,1,1,9,9,9,9,9,9,9,9,9,9,5,5,
  82. 5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  83. 9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  84. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,
  85. 1,7,7,1,7,1,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,
  86. 0,0,0,0,0,0,0,5,5,1,7,7,7,1,1,5,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,0,
  87. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,1,1,5,5,5,5,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,
  88. 5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,0,0,0,0,0,0,0,0,0,0,0,
  89. 0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  90. 0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  91. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  92. );
  93.       frame3 : icon = (
  94. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  95. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  96. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  97. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  98. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  99. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  100. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  101. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  102. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  103. 9,9,9,9,9,9,9,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,7,7,1,1,1,1,1,1,1,1,1,1,1,
  104. 1,1,1,1,9,9,9,9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,7,1,1,1,1,1,
  105. 1,1,0,0,0,1,1,1,1,1,1,1,9,9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,
  106. 0,7,1,1,7,7,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,5,5,5,1,7,7,7,7,5,5,5,5,5,5,
  107. 5,0,0,0,0,0,0,0,7,1,7,7,7,1,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,5,5,1,1,1,7,7,
  108. 1,1,7,5,5,5,5,5,5,5,0,0,0,0,0,0,1,1,7,1,1,7,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  109. 2,1,7,7,7,1,7,7,7,7,7,5,5,5,5,5,5,5,5,0,0,0,0,0,1,7,7,7,7,1,1,1,1,1,0,0,0,1,1,1,
  110. 1,1,1,2,2,2,2,2,2,1,7,7,7,7,7,7,7,1,1,5,5,5,5,5,5,5,5,5,0,0,0,0,7,7,1,7,1,7,1,1,
  111. 1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,1,1,1,1,1,1,2,2,5,5,5,5,5,5,5,5,5,5,5,0,0,0,
  112. 7,7,7,7,7,1,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,
  113. 5,5,5,5,5,0,0,0,7,7,0,0,7,7,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,
  114. 2,2,5,5,0,0,5,5,0,5,5,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  115. 2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  116. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,4,
  117. 4,6,6,6,6,6,6,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  118. 0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
  119. 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,3,3,1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,
  120. 9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  121. 9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  122. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  123. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  124. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  125. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  126. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  127. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  128. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  129. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  130. );
  131.  
  132.  
  133. VAR Virscr : VirtPtr;                      { Our first Virtual screen }
  134.     VirScr2 : VirtPtr;                     { Our second Virtual screen }
  135.     Vaddr  : word;                      { The segment of our virtual screen}
  136.     Vaddr2 : Word;                      { The segment of our 2nd virt. screen}
  137.     ourpal : Array [0..255,1..3] of byte; { A virtual pallette }
  138.     toaster : Array [1..10] of toastinfo; { The toaster info }
  139.  
  140. {──────────────────────────────────────────────────────────────────────────}
  141. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  142. BEGIN
  143.   asm
  144.      mov        ax,0013h
  145.      int        10h
  146.   end;
  147. END;
  148.  
  149.  
  150. {──────────────────────────────────────────────────────────────────────────}
  151. Procedure SetText;  { This procedure returns you to text mode.  }
  152. BEGIN
  153.   asm
  154.      mov        ax,0003h
  155.      int        10h
  156.   end;
  157. END;
  158.  
  159. {──────────────────────────────────────────────────────────────────────────}
  160. Procedure Cls (Col : Byte; Where:word);
  161.    { This clears the screen to the specified color }
  162. BEGIN
  163.      asm
  164.         push    es
  165.         mov     cx, 32000;
  166.         mov     es,[where]
  167.         xor     di,di
  168.         mov     al,[col]
  169.         mov     ah,al
  170.         rep     stosw
  171.         pop     es
  172.      End;
  173. END;
  174.  
  175.  
  176. {──────────────────────────────────────────────────────────────────────────}
  177. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  178.   { This puts a pixel on the screen by writing directly to memory. }
  179. BEGIN
  180.   Asm
  181.     push    ds
  182.     push    es
  183.     mov     ax,[where]
  184.     mov     es,ax
  185.     mov     bx,[X]
  186.     mov     dx,[Y]
  187.     push    bx                      {; and this again for later}
  188.     mov     bx, dx                  {; bx = dx}
  189.     mov     dh, dl                  {; dx = dx * 256}
  190.     xor     dl, dl
  191.     shl     bx, 1
  192.     shl     bx, 1
  193.     shl     bx, 1
  194.     shl     bx, 1
  195.     shl     bx, 1
  196.     shl     bx, 1                   {; bx = bx * 64}
  197.     add     dx, bx                  {; dx = dx + bx (ie y*320)}
  198.     pop     bx                      {; get back our x}
  199.     add     bx, dx                  {; finalise location}
  200.     mov     di, bx
  201.     {; es:di = where to go}
  202.     xor     al,al
  203.     mov     ah, [Col]
  204.     mov     es:[di],ah
  205.     pop     es
  206.     pop     ds
  207.   End;
  208. END;
  209.  
  210.  
  211. {──────────────────────────────────────────────────────────────────────────}
  212. procedure WaitRetrace; assembler;
  213.   {  This waits for a vertical retrace to reduce snow on the screen }
  214. label
  215.   l1, l2;
  216. asm
  217.     mov dx,3DAh
  218. l1:
  219.     in al,dx
  220.     and al,08h
  221.     jnz l1
  222. l2:
  223.     in al,dx
  224.     and al,08h
  225.     jz  l2
  226. end;
  227.  
  228.  
  229. {──────────────────────────────────────────────────────────────────────────}
  230. Procedure Pal(Col,R,G,B : Byte);
  231.   { This sets the Red, Green and Blue values of a certain color }
  232. Begin
  233.    asm
  234.       mov    dx,3c8h
  235.       mov    al,[col]
  236.       out    dx,al
  237.       inc    dx
  238.       mov    al,[r]
  239.       out    dx,al
  240.       mov    al,[g]
  241.       out    dx,al
  242.       mov    al,[b]
  243.       out    dx,al
  244.    end;
  245. End;
  246.  
  247. {──────────────────────────────────────────────────────────────────────────}
  248. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  249.   { This gets the Red, Green and Blue values of a certain color }
  250. Var
  251.    rr,gg,bb : Byte;
  252. Begin
  253.    asm
  254.       mov    dx,3c7h
  255.       mov    al,col
  256.       out    dx,al
  257.  
  258.       add    dx,2
  259.  
  260.       in     al,dx
  261.       mov    [rr],al
  262.       in     al,dx
  263.       mov    [gg],al
  264.       in     al,dx
  265.       mov    [bb],al
  266.    end;
  267.    r := rr;
  268.    g := gg;
  269.    b := bb;
  270. end;
  271.  
  272. {──────────────────────────────────────────────────────────────────────────}
  273. Procedure SetUpVirtual;
  274.    { This sets up the memory needed for the virtual screen }
  275. BEGIN
  276.   GetMem (VirScr,64000);
  277.   vaddr := seg (virscr^);
  278.   GetMem (VirScr2,64000);
  279.   vaddr2 := seg (virscr2^);
  280. END;
  281.  
  282.  
  283. {──────────────────────────────────────────────────────────────────────────}
  284. Procedure ShutDown;
  285.    { This frees the memory used by the virtual screen }
  286. BEGIN
  287.   FreeMem (VirScr,64000);
  288.   FreeMem (VirScr2,64000);
  289. END;
  290.  
  291.  
  292. {──────────────────────────────────────────────────────────────────────────}
  293. procedure flip(source,dest:Word);
  294.   { This copies the entire screen at "source" to destination }
  295. begin
  296.   asm
  297.     push    ds
  298.     mov     ax, [Dest]
  299.     mov     es, ax
  300.     mov     ax, [Source]
  301.     mov     ds, ax
  302.     xor     si, si
  303.     xor     di, di
  304.     mov     cx, 32000
  305.     rep     movsw
  306.     pop     ds
  307.   end;
  308. end;
  309.  
  310.  
  311. {──────────────────────────────────────────────────────────────────────────}
  312. Procedure putico(X,Y:Word;VAR sprt : icon;Where:Word); ASSEMBLER;
  313.   { This puts an icon, EXCEPT it's color 0 (black) pixels, onto the screen
  314.     "where", at position X,Y }
  315. label
  316.   _Redraw, _DrawLoop, _Exit, _LineLoop, _NextLine, _Store, _NoPaint;
  317.  
  318. asm
  319.     push  ds
  320.     push  es
  321.     lds   si,Sprt
  322.     mov   ax,X     { ax = x }
  323.     mov   bx,Y     { bx = y }
  324. _Redraw:
  325.     push    ax
  326.     mov     ax,[where]
  327.     mov     es,ax
  328.  
  329.     mov     ax, bx                  {; ax = bx  x = y}
  330.     mov     bh, bl                  {; y = y * 256  bx = bx * 256}
  331.     xor     bl, bl
  332.     shl     ax, 1
  333.     shl     ax, 1
  334.     shl     ax, 1
  335.     shl     ax, 1
  336.     shl     ax, 1
  337.     shl     ax, 1                   {; y = y * 64   ax = ax * 64}
  338.     add     bx, ax                  {; y = (y*256) + (Y*64)  bx = bx + ax (ie y*320)}
  339.  
  340.     pop     ax                      {; get back our x}
  341.  
  342.  
  343.     add     ax, bx                  {; finalise location}
  344.     mov     di, ax
  345.  
  346.     mov   dl,30    { dl = height of sprite }
  347.     xor   ch,ch
  348.     mov   cl,48     { cx = width of sprite }
  349.     cld
  350.     push  ax
  351.     mov   ax,cx
  352. _DrawLoop:
  353.     push  di            { store y adr. for later }
  354.     mov   cx,ax          { store width }
  355. _LineLoop:
  356.     mov   bl,byte ptr [si]
  357.     or    bl,bl
  358.     jnz   _Store
  359. _NoPaint:
  360.     inc    si
  361.     inc    di
  362.     loop   _LineLoop
  363.     jmp    _NextLine
  364. _Store:
  365.     movsb
  366.     loop  _LineLoop
  367. _NextLine:
  368.     pop   di
  369.     dec   dl
  370.     jz    _Exit
  371.     add   di,320        { di = next line of sprite }
  372.     jmp   _DrawLoop
  373. _Exit:
  374.     pop   ax
  375.     pop   es
  376.     pop   ds
  377. end;
  378.  
  379.  
  380.  
  381.  
  382.  
  383. {──────────────────────────────────────────────────────────────────────────}
  384. Procedure Funny_line(a,b,c,d:integer;where:word);
  385.   { This procedure draws a line from a,b to c,d on screen "where". After
  386.     each pixel it plots, it increments a color counter for the next pixel.
  387.     you may easily alter this to be a normal line procedure, and it will
  388.     be quite a bit faster than the origional one I gave you. This is
  389.     because I replaced all the reals with integers. }
  390.  
  391.   function sgn(a:real):integer;
  392.   begin
  393.        if a>0 then sgn:=+1;
  394.        if a<0 then sgn:=-1;
  395.        if a=0 then sgn:=0;
  396.   end;
  397. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  398.     count:integer;
  399. begin
  400.      count:=50;
  401.      u:= c - a;
  402.      v:= d - b;
  403.      d1x:= SGN(u);
  404.      d1y:= SGN(v);
  405.      d2x:= SGN(u);
  406.      d2y:= 0;
  407.      m:= ABS(u);
  408.      n := ABS(v);
  409.      IF NOT (M>N) then
  410.      BEGIN
  411.           d2x := 0 ;
  412.           d2y := SGN(v);
  413.           m := ABS(v);
  414.           n := ABS(u);
  415.      END;
  416.      s := m shr 1;
  417.      FOR i := 0 TO m DO
  418.      BEGIN
  419.           putpixel(a,b,count,where);
  420.           inc (count);
  421.           if count=101 then count:=50;
  422.           s := s + n;
  423.           IF not (s<m) THEN
  424.           BEGIN
  425.                s := s - m;
  426.                a:= a + d1x;
  427.                b := b + d1y;
  428.           END
  429.           ELSE
  430.           BEGIN
  431.                a := a + d2x;
  432.                b := b + d2y;
  433.           END;
  434.      end;
  435. END;
  436.  
  437.  
  438.  
  439. {──────────────────────────────────────────────────────────────────────────}
  440. Procedure SetUpScreen;
  441.   { This procedure sets up the static background to be used in the program }
  442.  
  443. CONST circ : Array [1..5,1..5] of byte =
  444.         ((0,10,10,10,0),
  445.          (10,13,12,11,10),
  446.          (10,12,12,11,10),
  447.          (10,11,11,11,10),
  448.          (0,10,10,10,0));
  449.  
  450. VAR x,y:integer;
  451.     loop1,loop2,loop3:integer;
  452.  
  453. BEGIN
  454.   pal (1,22,22,22);
  455.   pal (2,45,45,45);
  456.   pal (3,59,59,59);
  457.   pal (4,63,63,27);
  458.   pal (5,39,63,3);
  459.   pal (6,51,39,3);
  460.   pal (7,3,27,3);
  461.   pal (8,15,39,15);
  462.   pal (9,35,35,35);
  463.   pal (10, 0, 0,40);
  464.   pal (11,10,10,50);
  465.   pal (12,20,20,60);
  466.   pal (13,30,30,63);
  467.  
  468.   For loop1:=50 to 100 do
  469.     pal (loop1,0,0,loop1-36);
  470.  
  471.   For loop1:=0 to 255 do
  472.      getpal (loop1,OurPal[loop1,1],OurPal[loop1,2],OurPal[loop1,3]);
  473.  
  474.   For loop1:=0 to 319 do
  475.     Funny_line (0,199,loop1,0,vaddr);
  476.   For loop1:=0 to 199 do
  477.     Funny_line (0,199,319,loop1,vaddr);
  478.  
  479.   For loop1:=1 to 200 do BEGIN
  480.     x:=random (315);
  481.     y:=random (195);
  482.     For loop2:=1 to 5 do
  483.       For loop3:=1 to 5 do
  484.         if circ [loop2,loop3]<>0 then
  485.           putpixel (x+loop2,y+loop3,circ [loop2,loop3],vaddr);
  486.   END;
  487.   flip (vaddr,vga);  { Copy the entire screen at vaddr, our virtual screen }
  488.                      { on which we have done all our graphics, onto the    }
  489.                      { screen you see, VGA }
  490.   flip (vaddr,vaddr2);
  491. END;
  492.  
  493.  
  494. {──────────────────────────────────────────────────────────────────────────}
  495. Procedure rotatepal;
  496.   { This procedure rotates the colors between 50 and 100 }
  497. VAR temp : Array [1..3] of byte;
  498.     loop1:integer;
  499. BEGIN
  500.   Move(OurPal[100],Temp,3);
  501.   Move(OurPal[50],OurPal[51],50*3);
  502.   Move(Temp,OurPal[50],3);
  503.   For loop1:=50 to 100 do
  504.     pal (loop1,OurPal[loop1,1],OurPal[loop1,2],OurPal[loop1,3]);
  505. END;
  506.  
  507.  
  508. {──────────────────────────────────────────────────────────────────────────}
  509. Procedure ScreenTrans (x,y:word);
  510.   { This is a small procedure to copy a 30x30 pixel block from coordinates
  511.     x,y on the virtual screen to coordinates x,y on the true vga screen }
  512. BEGIN
  513.   asm
  514.     push    ds
  515.     push    es
  516.     mov     ax,vaddr
  517.     mov     es,ax
  518.     mov     ax,vaddr2
  519.     mov     ds,ax
  520.     mov     bx,[X]
  521.     mov     dx,[Y]
  522.     push    bx                      {; and this again for later}
  523.     mov     bx, dx                  {; bx = dx}
  524.     mov     dh, dl                  {; dx = dx * 256}
  525.     xor     dl, dl
  526.     shl     bx, 1
  527.     shl     bx, 1
  528.     shl     bx, 1
  529.     shl     bx, 1
  530.     shl     bx, 1
  531.     shl     bx, 1                   {; bx = bx * 64}
  532.     add     dx, bx                  {; dx = dx + bx (ie y*320)}
  533.     pop     bx                      {; get back our x}
  534.     add     bx, dx                  {; finalise location}
  535.     mov     di, bx                  {; es:di = where to go}
  536.     mov     si, di
  537.     mov     al,60
  538.     mov     bx, 30         { Hight of block to copy }
  539. @@1 :
  540.     mov     cx, 24         { Width of block to copy divided by 2 }
  541.     rep     movsw
  542.     add     di,110h        { 320 - 48 = 272 .. or 110 in hex }
  543.     add     si,110h
  544.     dec     bx
  545.     jnz     @@1
  546.  
  547.     pop     es
  548.     pop     ds
  549.   end;
  550.   { I wrote this procedure late last night, so it may not be in it's
  551.     most optimised state. Sorry :-)}
  552. END;
  553.  
  554.  
  555. {──────────────────────────────────────────────────────────────────────────}
  556. Procedure NewToaster;
  557.   { This adds a new toaster to the screen }
  558. VAR loop1:integer;
  559. BEGIN
  560.   loop1:=0;
  561.   repeat
  562.     inc (loop1);
  563.     if not (toaster[loop1].active) then BEGIN
  564.       toaster[loop1].x:=random (200)+70;
  565.       toaster[loop1].y:=0;
  566.       toaster[loop1].active:=true;
  567.       toaster[loop1].frame:=1;
  568.       toaster[loop1].speed:=Random (3)+1;
  569.       loop1:=10;
  570.     END;
  571.   until loop1=10;
  572. END;
  573.  
  574.  
  575. {──────────────────────────────────────────────────────────────────────────}
  576. Procedure Fly;
  577.   { This is the procedure where we move and put the toasters }
  578. VAR loop1,loop2:integer;
  579.     ch:char;
  580. BEGIN
  581.   For loop1:=1 to 10 do
  582.     toaster[loop1].active:=FALSE;
  583.   ch:=#0;
  584.   NewToaster;
  585.   Repeat
  586.     if keypressed then BEGIN
  587.       ch:=readkey;
  588.       if ch='+' then NewToaster;      { If '+' is pressed, add a toaster }
  589.       if ch='-' then BEGIN            { if '-' is pressed, remove a toaster }
  590.         loop1:=0;
  591.         repeat
  592.           inc (loop1);
  593.           if toaster[loop1].active then BEGIN
  594.             screentrans (toaster[loop1].x,toaster[loop1].y);
  595.             toaster [loop1].active:=FALSE;
  596.             loop1:=10;
  597.           END;
  598.         until loop1=10;
  599.       END;
  600.     END;
  601.     for loop1:=1 to 10 do
  602.       if toaster[loop1].active then BEGIN
  603.         screentrans (toaster[loop1].x,toaster[loop1].y);
  604.           { Restore the backgrond the toaster was over }
  605.         dec (toaster[loop1].x,toaster[loop1].speed);
  606.         inc (toaster[loop1].y,toaster[loop1].speed);
  607.           { Move the toaster }
  608.         if (toaster[loop1].x<1) or (toaster[loop1].y>170) then BEGIN
  609.           toaster[loop1].active:=FALSE;
  610.           NewToaster;
  611.         END;
  612.           { When toaster reaches the edge of the screen, render it inactive
  613.             and bring a new one into existance. }
  614.       END;
  615.     for loop1:=1 to 10 do
  616.       if toaster[loop1].active then BEGIN
  617.         CASE toaster [loop1].frame of
  618.            1   : putico (toaster[loop1].x,toaster[loop1].y,frame1,vaddr);
  619.            3   : putico (toaster[loop1].x,toaster[loop1].y,frame2,vaddr);
  620.            2,4 : putico (toaster[loop1].x,toaster[loop1].y,frame3,vaddr);
  621.         END;
  622.         toaster[loop1].frame:=toaster[loop1].frame+1;
  623.         if toaster [loop1].frame=5 then toaster[loop1].frame:=1;
  624.           { Draw all the toasters on the VGA screen }
  625.       END;
  626.     waitretrace;
  627.     flip (vaddr,vga);
  628.     rotatepal;
  629.   Until ch=#27;
  630. END;
  631.  
  632.  
  633. BEGIN
  634.   Randomize;       { Make sure that the RANDOM funcion really is random }
  635.   SetupVirtual;    { Set up virtual page, VADDR }
  636.   ClrScr;
  637.   writeln ('Hello! This program will demonstrate the principals of animation.');
  638.   writeln ('The program will firstly generate an arb background screen to a');
  639.   writeln ('virtual page, then flip it to the VGA. A toaster will then start');
  640.   writeln ('to move across the screen. Note that the background will be restored');
  641.   writeln ('after the toaster has passed over it. You may add or remove toasters');
  642.   writeln ('by hitting "+" or "-" respectively. Note that the more frames you');
  643.   writeln ('use, usually the better the routine looks. Because of space');
  644.   writeln ('restrictions, we only had room for three frames.');
  645.   writeln;
  646.   writeln ('The toasters were drawn by Fubar (Pieter Buys) in Autodesk Animator.');
  647.   writeln ('I wrote a small little program to convert them into CONSTANTS. See');
  648.   writeln ('the main text to find out how to load up AA CEL files directly.');
  649.   writeln;
  650.   writeln;
  651.   Write ('  Hit any key to contine ...');
  652.   Readkey;
  653.   SetMCGA;
  654.   SetupScreen;     { Draw the background screen to VADDR, then flip it to
  655.                      the VGA screen }
  656.   Fly;             { Make the toasters fly around the screen }
  657.   SetText;
  658.   ShutDown;        { Free the memory taken up by virtual page }
  659.   Writeln ('All done. This concludes the seventh sample program in the ASPHYXIA');
  660.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  661.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  662.   Writeln ('Connectix BBS user, which is unfortunatly offline for the moment.');
  663.   Writeln ('For discussion purposes, I am also the moderator of the Programming');
  664.   Writeln ('newsgroup on the For Your Eyes Only BBS.');
  665.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  666.   Writeln ('             Grant Smith');
  667.   Writeln ('             P.O. Box 270');
  668.   Writeln ('             Kloof');
  669.   Writeln ('             3640');
  670.   Writeln ('I hope to hear from you soon!');
  671.   Writeln; Writeln;
  672.   Write   ('Hit any key to exit ...');
  673.   Readkey;
  674. END.
  675.